home *** CD-ROM | disk | FTP | other *** search
/ Gekikoh Dennoh Club 1 / Gekikoh Dennoh Club Vol. 1 (Japan).7z / Gekikoh Dennoh Club Vol. 1 (Japan) (Track 1).bin / tools / dcv_win / src / cut_main.pas next >
Encoding:
Pascal/Delphi Source File  |  1996-01-18  |  9.7 KB  |  367 lines
  1. unit Cut_main;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, ExtCtrls, Menus, StdCtrls, WinCrt;
  8.  
  9. type
  10.   TForm1 = class(TForm)
  11.     MainMenu1: TMainMenu;
  12.     File1: TMenuItem;
  13.     Exit1: TMenuItem;
  14.     N1: TMenuItem;
  15.     PrintSetup1: TMenuItem;
  16.     Print1: TMenuItem;
  17.     N2: TMenuItem;
  18.     SaveAs1: TMenuItem;
  19.     Open1: TMenuItem;
  20.     OpenDialog1: TOpenDialog;
  21.     procedure Open1Click(Sender: TObject);
  22.     procedure Exit1Click(Sender: TObject);
  23.     procedure FormCreate(Sender: TObject);
  24.     procedure ApplicationActivate(Sender: TObject);
  25.     procedure FormResize(Sender: TObject);
  26.  
  27.   private
  28.     { Private 宣言 }
  29.   public
  30.     { Public 宣言 }
  31.   end;
  32.  
  33. var
  34.   Form1: TForm1;
  35.   cutSize: Longint;
  36.   cut_x, cut_y: Integer;
  37.   cutBmp: TBitmap;
  38.   isDraw: Integer;
  39.   function cutType(Ptr:PChar): Boolean;
  40.   function expand1(org:PChar; count:Integer; cond:PChar): Integer;
  41.   function expand2(org2:PChar; count2:Integer; cond2, lbuff:PChar): Integer;
  42.   function cutPrint(xbuff: PChar; cutWidth, ofset: Integer): Boolean;
  43.   function cutRedraw(iscc: Integer): Boolean;
  44.  
  45. implementation
  46.  
  47. {$R *.DFM}
  48.  
  49. procedure Tform1.Open1Click(Sender: TObject);
  50. type
  51.     bytePtr = ^Char;
  52. var
  53.    f: file of Byte;
  54.    fileHdl, i: Integer;
  55.    cutPt, cutPt2, nstr: PChar;
  56.    buf: Char;
  57.    header, buff: String;
  58. begin
  59.      if OpenDialog1.Execute then
  60.      begin
  61.      { Get CutFileSize }
  62.      AssignFile(f, OpenDialog1.FileName);
  63.      Reset(f);
  64.      cutSize := FileSize(f);
  65.      CloseFile(f);
  66.      { CutTypeProcced }
  67.      if MaxAvail < cutSize then
  68.         MessageDlg('Not enough memory', mtWarning, [mbOk], 0)
  69.      else
  70.      begin
  71.           { Get Bitmap }
  72.           if (isDraw = 1) then cutBmp.free;
  73.           cutBmp := TBitmap.create;
  74.           { Get Memory}
  75.           GetMem(cutPt, cutSize);
  76.           { fileRead & Close }
  77.           fileHdl := FileOpen(OpenDialog1.FileName, OF_SHARE_COMPAT);
  78.           FileRead(fileHdl, cutPt^, cutSize);
  79.           FileClose(fileHdl);
  80.           { CutFile? }
  81.           cutPt2 := cutPt;
  82.           GetMem(nstr, 64);
  83.           StrPas(StrMove(nstr, cutPt, 48));
  84.           Inc(cutPt,48);
  85.           if (compareText('CUT_V', Copy(StrPas(nstr),1,5)) = 0) then
  86.              cutType(cutPt);
  87.           { Dispose Memory }
  88.           FreeMem(nstr, 64);
  89.           FreeMem(cutPt2, cutSize);
  90.           { Bitmap To Form.Canvas }
  91.           form1.canvas.draw(0,0,cutBmp);
  92.           isDraw := 1;
  93.      end;
  94.  
  95.      end;
  96. end;
  97.  
  98. procedure Tform1.Exit1Click(Sender: TObject);
  99. begin
  100.      close;
  101. end;
  102.  
  103. function cutType(Ptr:PChar): Boolean;
  104. var
  105.    xx, yy, xsize, image_y, i: Integer;
  106.    sstr, buffer, bufferPt: PChar;
  107.    head, body: PChar;
  108.    con1, con2, con1buff: PChar;
  109.    dmy, j, y_ofset: integer;
  110.    dmyStr: String;
  111.    dmynull: PChar;
  112.    lineBuf: PChar;
  113.    cutRc: TRect;
  114. begin
  115.      { CutSize? xx,yy }
  116.      GetMem(sstr, 10);
  117.      xx := Integer(Ptr^) * 256;
  118.      Inc(Ptr, 1);
  119.      xx := xx + Integer(Ptr^);
  120.      Inc(Ptr, 1);
  121.      yy := Integer(Ptr^) * 256;
  122.      Inc(Ptr, 1);
  123.      yy := yy + Integer(Ptr^);
  124.      Inc(Ptr, 1);
  125.      FreeMem(sstr, 10);
  126.      { BitMap }
  127.      cutBmp.canvas.brush.color := clGreen;
  128.      cutBmp.canvas.FillRect(cutRc);
  129.      cutBmp.width := xx;
  130.      cutBmp.height := yy;
  131.      cutBmp.Monochrome := False;
  132.      { Set Cursor crHourGlass }
  133.      screen.cursor := crHourGlass;
  134.      { typeCut }
  135.      GetMem(buffer, 256*16);
  136.      GetMem(con1, 256);
  137.      GetMem(con2, 256);
  138.      GetMem(lineBuf, 256);
  139.      xsize := (xx - 1) div 8 + 1;
  140.      image_y := 0;
  141.      y_ofset := -16;
  142.      bufferPt := buffer;
  143.  
  144.      GetMem(dmyNull, 10);
  145.  
  146.      expand2(buffer, 0, con2, lineBuf);
  147.      for i:=1 to yy do
  148.      begin
  149.           con1buff := con1;
  150.           dmy := Integer(Ptr^);
  151.           for j:=1 to dmy do
  152.           begin
  153.               con1buff^ := Ptr^;
  154.               Inc(Ptr, 1);
  155.               Inc(con1buff, 1);
  156.           end;
  157.           dmy := Integer(con1^);
  158.  
  159.           if (dmy<=0) then break;
  160.           expand1(con2, xsize, con1);
  161.           expand2(buffer, xsize, con2, lineBuf);
  162.           Inc(buffer, xsize);
  163.  
  164.           Inc(image_y, 1);
  165.           Inc(y_ofset, 1);
  166.           if (image_y = 16) then
  167.           begin
  168.                image_y := 0;
  169.                buffer := bufferPt;
  170.                cutPrint(buffer, xx, y_ofset);
  171.           end;
  172.      end;
  173.      if (image_y > 0) then
  174.      begin
  175.           buffer := bufferPt;
  176.           cutPrint(buffer, xx, y_ofset);
  177.      end;
  178.      FreeMem(lineBuf, 256);
  179.      FreeMem(con2, 256);
  180.      FreeMem(con1, 256);
  181.      FreeMem(bufferPt, 256*16);
  182.      { Reset FormSize }
  183.      form1.caption := ExtractFileName(form1.opendialog1.filename)+' ('+IntToStr(xx)+','+IntToStr(yy)+')';
  184.      cutRc := Rect(0,0,xx,yy);
  185.      form1.clientwidth := xx;
  186.      form1.clientheight := yy;
  187.      { Reset Cursor crHDefault }
  188.      screen.cursor := crDefault;
  189. end;
  190.  
  191. function expand1(org:PChar; count:Integer; cond:PChar): Integer;
  192. var
  193.    pt, bt, flag, i: Integer;
  194.    head, body: PChar;
  195. begin
  196.      if (cond^ = Chr(1))then
  197.      begin
  198.           for pt:=1 to count do
  199.           begin
  200.               org^ := Chr(0);
  201.               Inc(org, 1);
  202.           end;
  203.           expand1 := count;
  204.           exit;
  205.      end;
  206.      pt := (count - 1) div 8 + 1;
  207.      head := cond + 1;
  208.      body := head + pt;
  209.      for i:= 1 to Pt do
  210.      begin
  211.           flag := Integer(head^);
  212.           Inc(head, 1);
  213.           for bt:=0 to 7 do
  214.           begin
  215.                if ((flag And 128) = 0) then
  216.                   org^ := Chr(0)
  217.                else
  218.                begin
  219.                   org^ := body^;
  220.                   Inc(body, 1);
  221.                end;
  222.                Inc(org, 1);
  223.                flag := flag shl 1;
  224.           end;
  225.      end;
  226.      expand1 := count;
  227. end;
  228.  
  229. function expand2(org2:PChar; count2:Integer; cond2, lbuff:PChar): Integer;
  230. var
  231.      c: Integer;
  232. begin
  233.      if (count2 = 0) then
  234.      begin
  235.         for c := 1 to 128 do
  236.         begin
  237.              lbuff^ := Char(0);
  238.              Inc(lbuff, 1);
  239.         end;
  240.         expand2 := count2;
  241.         exit;
  242.      end;
  243.      for c:=1 to count2 do
  244.      begin
  245.          org2^ := Chr(Integer(cond2^) Xor Integer(lbuff^));
  246.          lbuff^ := org2^;
  247.          Inc(org2, 1);
  248.          Inc(cond2, 1);
  249.          Inc(lbuff, 1);
  250.      end;
  251.      expand2 := count2;
  252. end;
  253.  
  254. function cutPrint(xbuff: PChar; cutWidth, ofset: Integer): Boolean;
  255. var
  256.    cr: PChar;
  257.    flg2: Integer;
  258.    i,j,k,ke:Integer;
  259.    x_offset, cll, cll2: Integer;
  260. begin
  261.      if ((ofset mod 16) = 0) then
  262.         ke := 15
  263.      else
  264.      begin
  265.         ke := ofset Mod 16 - 1;
  266.         ofset := ofset + 16 - ke - 1;
  267.      end;
  268.      for k:= 0 to ke do
  269.      begin
  270.          cutBmp.canvas.pen.color := clGreen;
  271.          cutBmp.canvas.MoveTo(-1,ofset + k);
  272.          for i:=0 to (cutWidth div 8)-1 do
  273.          begin
  274.               flg2 := 128;
  275.               x_offset := i*8;
  276.               for j:=0 to 7 do
  277.               begin
  278.                    if ( Integer(xbuff^) And flg2 <> 0) then
  279.                         cll := 1
  280.                    else
  281.                         cll := 0;
  282.                    if (cll <> cll2) then
  283.                    begin
  284.                         if (cll = 1) then
  285.                         begin
  286.                            cutBmp.canvas.pen.color := clGreen;
  287.                            cutBmp.canvas.moveTo(x_offset+j,ofset + k);
  288.                         end;
  289.                         if (cll = 0) then
  290.                         begin
  291.                            cutBmp.canvas.pen.color := clWhite;
  292.                            cutBmp.canvas.LineTo(x_offset+j,ofset + k);
  293.                         end;
  294.                         cll2 := cll;
  295.                    end;
  296.                    flg2 := flg2 shr 1;
  297.               end;
  298.               Inc(xbuff, 1);
  299.          end;
  300.          if ((cutWidth mod 8) > 0) then
  301.          begin
  302.               flg2 := 128;
  303.               x_offset := (i+1)*8;
  304.               for j:=0 to (cutWidth mod 8) do
  305.               begin
  306.                    if ( Integer(xbuff^) And flg2 <> 0) then
  307.                       cll := 1
  308.                    else
  309.                       cll := 0;
  310.                    if (cll <> cll2) then
  311.                    begin
  312.                         if (cll = 1) then
  313.                         begin
  314.                              cutBmp.canvas.pen.color := clGreen;
  315.                              cutBmp.canvas.moveTo(x_offset+j,ofset + k);
  316.                         end;
  317.                         if (cll = 0) then
  318.                         begin
  319.                              cutBmp.canvas.pen.color := clWhite;
  320.                              cutBmp.canvas.LineTo(x_offset+j,ofset + k);
  321.                         end;
  322.                         cll2 := cll;
  323.                    end;
  324.                    flg2 := flg2 shr 1;
  325.               end;
  326.               Inc(xbuff, 1);
  327.          end;
  328.          if (cll = 0) then
  329.          begin
  330.               cutBmp.canvas.pen.color := clGreen;
  331.               cutBmp.canvas.lineTo(cutWidth,ofset + k);
  332.          end;
  333.          if (cll = 1) then
  334.          begin
  335.               cutBmp.canvas.pen.color := clWhite;
  336.               cutBmp.canvas.LineTo(cutWidth,ofset + k);
  337.          end;
  338.      end;
  339. end;
  340.  
  341.  
  342. procedure TForm1.FormCreate(Sender: TObject);
  343. begin
  344.      isDraw := 0;
  345.      Application.OnActivate := ApplicationActivate;
  346. end;
  347.  
  348. procedure TForm1.ApplicationActivate(Sender: TObject);
  349. begin
  350.      cutRedraw(isDraw);
  351. end;
  352.  
  353. function cutRedraw(iscc: Integer): Boolean;
  354. begin
  355.      if (iscc > 0) then
  356.           form1.canvas.draw(0,0,cutBmp);
  357. end;
  358.  
  359.  
  360. procedure TForm1.FormResize(Sender: TObject);
  361. begin
  362.      if (isDraw > 0) then
  363.           form1.canvas.draw(0,0,cutBmp);
  364. end;
  365.  
  366. end.
  367.